home *** CD-ROM | disk | FTP | other *** search
/ Trading on the Edge / Trading On The Edge - CD-ROM Toolkit (Wayzata Technology)(2031)(1994).bin / mac / Shared / Freeman / Art.m < prev    next >
Text File  |  1994-01-06  |  7KB  |  177 lines
  1. BeginPackage["Art`"]
  2.  
  3. vmag1::usage = "vmag1[v]"
  4. vmag2::usage = "vmag2[v]"
  5. resetflag1::usage = "resetflag1[outp,inp,rho]"
  6. resetflag2::usage = "resetflag2[u,p,c,rho]"
  7. winner::usage = "winner[p,val]"
  8. compete::usage = "compete[f2Activities]"
  9. art1Init::usage = "art1Init[f1dim,f2dim,b1,d1,el,del1,del2]"
  10. art1::usage = "art1[f1dim,f2dim,a1,b1,c1,d1,el,rho,f1Wts,f2Wts,inputs]"
  11. art2F1::usage = "art2F1[in,a,b,d,tdWts,f1d,winr:0]"
  12. art2Init::usage = "art2Init[f1dim,f2dim,d,del1]"
  13. art2::usage = "art2[f1dim,f2dim,a1,b1,c1,d,theta,rho,f1Wts,f2Wts,inputs]"
  14.  
  15.  
  16. Begin["`Private`"]    (* begin the private context *)
  17.  
  18. (* vmag for ART1 networks *)
  19. vmag1[v_] := Count[v,1]
  20.  
  21.  
  22. (*  vmag for ART2 networks  *)
  23. vmag2[v_] = Sqrt[v . v]
  24.  
  25.  
  26. (* reset for ART1 *)
  27. resetflag1[outp_,inp_,rho_] := 
  28.         If[vmag1[outp]/vmag1[inp]<rho,True,False]
  29.  
  30.  
  31. (* reset for ART2 *)
  32. resetflag2[u_,p_,c_,rho_]:=
  33.     Module[{r,flag},
  34.         r = (u + c p) / (vmag2[u] + vmag2[c p]);
  35.         If[rho/vmag2[r] > 1,flag=True,flag=False];
  36.         Return[flag];
  37.         ];  
  38.  
  39.  
  40. winner[p_,val_] := First[First[Position[p,val]]]
  41.  
  42.  
  43. compete[f2Activities_] :=
  44.   Module[{i,x,f2dim,maxpos},
  45.     x=f2Activities;
  46.     maxpos=First[First[Position[x,Max[f2Activities]]]];
  47.     f2dim = Length[x];
  48.     For[i=1,i<=f2dim,i++,
  49.            If[i!=maxpos,x[[i]]=0;Continue]  (* end of If  *)
  50.          ]; (* end of For  *)
  51.     Return[x];
  52.     ];  (* end of Module *)
  53.  
  54.  
  55. art1Init[f1dim_,f2dim_,b1_,d1_,el_,del1_,del2_] :=
  56.   Module[{z12,z21},
  57.    z12 = Table[Table[(b1-1)/d1 + del1,{f2dim}],{f1dim}];
  58.    z21 = Table[Table[(el/(el-1+f1dim)-del2),{f1dim}],{f2dim}];
  59.    Return[{z12,z21}];
  60.    ]; (* end of Module *)
  61.  
  62.  
  63.  
  64. art1[f1dim_,f2dim_,a1_,b1_,c1_,d1_,el_,rho_,f1Wts_,f2Wts_,inputs_] :=
  65.   Module[{droplistinit,droplist,notDone=True,i,nIn=Length[inputs],reset,
  66.             n,sf1,t,xf2,uf2,v,windex,matchList,newMatchList,tdWts,buWts},
  67.    droplistinit = Table[1,{f2dim}];   (* initialize droplist *)
  68.    tdWts=f1Wts; buWts=f2Wts;
  69.    matchList =    (* construct list of F2 units and encoded input patterns *)
  70.           Table[{StringForm["Unit ",n]},{n,f2dim}];
  71.    While[notDone==True,newMatchList = matchList; (* process until stable *)
  72.       For[i=1,i<=nIn,i++,in = inputs[[i]];       (* process inputs in sequence *)
  73.         droplist = droplistinit;reset=True;      (* initialize *)
  74.         While[reset==True,                          (* cycle until no reset *)
  75.            xf1 = in/(1+a1*(in+b1)+c1);              (* activities *)
  76.            sf1 = Map[If[#>0,1,0]&,xf1];             (* F1 outputs *)
  77.            t= buWts . sf1;                          (* F2 net-inputs *)
  78.            t = t droplist;                          (* turn off inhibited units *)
  79.            xf2 = compete[t];                           (* F2 activities *)
  80.            uf2 = Map[If[#>0,1,0]&,xf2];             (* F2 outputs *)
  81.            windex = winner[uf2,1];                  (* winning index *)
  82.            v= tdWts . uf2;                                (* F1 net-inputs *)
  83.            xf1 =(in+ d1*v-b1)/(1+a1*(in+d1*v)+c1);  (* new F1 activities *)
  84.            sf1 = Map[If[#>0,1,0]&,xf1];             (* new F1 outputs *)
  85.            reset = resetflag1[sf1,in,rho];          (* check reset *)
  86.            If[reset==True,droplist[[windex]]=0;     (* update droplist *)
  87.                    Print["Reset with pattern ",i," on unit ",windex],Continue];
  88.            ]; (* end of While reset==True *)
  89.         Print["Resonance established on unit ",windex," with pattern ",i];
  90.      tdWts=Transpose[tdWts];   (* resonance, so update weights,top down first *)
  91.            tdWts[[windex]]=sf1;  
  92.            tdWts=Transpose[tdWts];
  93.            buWts[[windex]] = el/(el-1+vmag1[sf1]) sf1; (* then bottom up *)
  94.      matchList[[windex]] =                          (* update matching list *)
  95.                        Reverse[Union[matchList[[windex]],{i}]];
  96.          ];  (* end of For i=1 to nIn *)
  97.       If[matchList==newMatchList,notDone=False;    (* see if matchList is static *)
  98.               Print["Network stable"],
  99.               Print["Network not stable"];
  100.               newMatchList = matchList];];  (* end of While notDone==True *)
  101.    Return[{tdWts,buWts,matchList}];
  102.    ];    (* end of Module *)        
  103.  
  104.  
  105.  
  106. art2F1[in_,a_,b_,d_,tdWts_,f1d_,winr_:0] :=
  107.   Module[{w,x,u,v,p,q,i},
  108.     w=x=u=v=p=q=Table[0,{f1d}];
  109.     For[i=1,i<=2,i++,
  110.       w = in + a u;
  111.       x = w / vmag2[w];
  112.       v = f[x] + b f[q];
  113.       u = v / vmag2[v];
  114.       p = If[winr==0,u,
  115.                  u + d Transpose[tdWts][[winr]] ];
  116.      q = p / vmag2[p];
  117.      ];  (* end of For i *)
  118.     Return[{u,p}];
  119.     ]  (* end of Module *)
  120.  
  121.  
  122.  
  123. art2Init[f1dim_,f2dim_,d_,del1_] :=
  124.   Module[{z12,z21},
  125.    z12 = Table[Table[0 ,{f2dim}],{f1dim}];
  126.    z21 = Table[Table[del1/((1-d)*Sqrt[f1dim] ),
  127.                 {f1dim}],{f2dim}];
  128.    Return[{z12,z21}];
  129.    ]; (* end of Module *)
  130.  
  131.  
  132.  
  133. art2[f1dim_,f2dim_,a1_,b1_,c1_,d_,theta_,rho_,f1Wts_,f2Wts_,inputs_] :=
  134.   Module[{droplistinit,droplist,notDone=True,i,nIn= Length[inputs],reset,
  135.             u,p,t,xf2,uf2,v,windex,matchList,newMatchList,tdWts,buWts},
  136.     droplistinit = Table[1,{f2dim}];     (* initialize droplist *)
  137.     tdWts = f1Wts; buWts = f2Wts;
  138.     u = p = Table[0,{f1dim}];
  139.             (* construct list of F2 units and encodedinput patterns *)
  140.       matchList = Table[{StringForm["Unit ``",n]},{n,f2dim}];
  141.     While[notDone==True,newMatchList = matchList;  (* process until stable *)
  142.       For[i=1,i<=nIn,i++,          (* process each input pattern in sequence *)
  143.         droplist = droplistinit;   (* initialize droplist for new input *)
  144.         reset=True;
  145.         in = inputs[[i]];          (* next input pattern *)
  146.         windex = 0;                (* initialize  *)
  147.         While[reset==True,            (* cycle until no reset *)
  148.            {u,p} = art2F1[in,a1,b1,d,tdWts,f1dim,windex];
  149.            t= buWts . p;                    (* F2 net-inputs *)
  150.            t = t droplist;            (* turn off inhibited units *)
  151.            xf2 = compete[t];             (* F2 activities *)
  152.            uf2 = Map[g,xf2];          (* F2 outputs *)
  153.            windex = winner[uf2,d];   (* winning index *)
  154.              {u,p} = art2F1[in,a1,b1,d,tdWts,f1dim,windex];
  155.            reset = resetflag2[u,p,c1,rho];  (* check reset *)
  156.            If[reset==True,droplist[[windex]]=0;    (* update droplist *)
  157.                    Print["Reset with pattern ",i," on unit ",windex],Continue];
  158.            ]; (* end of While reset==True *)
  159.    Print["Resonance established on unit ",    windex," with pattern ",i];
  160.    tdWts=Transpose[tdWts];  (* resonance, so update weights *)
  161.          tdWts[[windex]]=u/(1-d);  tdWts=Transpose[tdWts];  
  162.          buWts[[windex]] = u/(1-d);
  163.          matchList[[windex]] =     (* update matching list *)
  164.       Reverse[Union[matchList[[windex]],{i}]];
  165.          ];  (* end of For i=1 to nIn *)
  166.       If[matchList==newMatchList,notDone=False;   (* see if matchList is static *)
  167.               Print["Network stable"],Print["Network not stable"];
  168.               newMatchList = matchList];
  169.       ];  (* end of While notDone==True *)
  170.    Return[{tdWts,buWts,matchList}];
  171.    ];    (* end of Module *)        
  172.  
  173.  
  174.  
  175. End[]         (* end the private context *)
  176.  
  177. EndPackage[]  (* end the package context *)